System Functions

Many internal Windows values and parameters are beyond Visual Basic's capabilities, but they're just an API function call away. In this section, I show how you can retrieve some important system settings and how you can augment Visual Basic support for the mouse and the keyboard.

Even though Visual Basic hides most of the complexities of the operating system, as well as the differences among the many Windows versions around, sometimes you must distinguish one from another—for example to account for minor differences between Windows 9x and Windows NT. You can do this by examining the higher-order bit of the Long value returned by the GetVersion API function:

Private Declare Function GetVersion Lib "kernel32" () As Long If GetVersion() And &H80000000 Then MsgBox "Running under Windows 95/98" Else MsgBox "Running under Windows NT" End If

If you need to determine the actual Windows version, you need the GetVersionEx API function, which returns information about the running operating system in a UDT:

Type OSVERSIONINFO dwOSVersionInfoSize As Long dwMajorVersion As Long dwMinorVersion As Long dwBuildNumber As Long dwPlatformId As Long szCSDVersion As String * 128 End Type Private Declare Function GetVersionEx Lib "kernel32" Alias _ "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long Dim os As OSVERSIONINFO, ver As String ' The function expects the UDT size in the UDT's first element. os.dwOSVersionInfoSize = Len(os) GetVersionEx os ver = os.dwMajorVersion & "." & Right$("0" & Format$(os.dwMinorVersion), 2) Print "Windows Version = " & ver Print "Windows Build Number = " & os.dwBuildNumber

Windows 95 returns a version number 4.00, whereas Windows 98 returns version 4.10. (See Figure A-4.) You can use the build number to identify different service packs.

All tips and tricks collections show how you can retrieve the path to the main Windows and System directories, which are often useful for locating other files that might interest you. These functions are helpful for another reason as well: They show you how to receive strings from an API function. In general, no API function directly returns a string; instead, all the functions that return a string value to the calling program require that you create a receiving string buffer—typically, a string filled with spaces or null characters—and you pass it to the routine. Most of the time, you must pass the buffer's length in another argument so that the API function doesn't accidentally write in the buffer more characters than allowed. For example, this is the declaration of the GetWindowsDirectory API function:

Private Declare Function GetWindowsDirectory Lib "kernel32" Alias _ "GetWindowsDirectoryA" (ByVal lpBuffer As String, _ ByVal nSize As Long) As Long

Figure A-4. The sample program demonstrates several system, keyboard, and mouse API functions.

You use this function by allocating a large-enough buffer, and then you pass it to the function. The return value of the function is the actual number of characters in the result string, and you can use this value to trim off characters in excess:

Dim buffer As String, length As Integer buffer = Space$(512) length = GetWindowsDirectory(buffer, Len(buffer)) Print "Windows Directory = " & Left$(buffer, length)

You can use the same method to determine the path of the Windows\System directory, using the GetSystemDirectory API function:

Private Declare Function GetSystemDirectory Lib "kernel32" Alias _ "GetSystemDirectoryA" (ByVal lpBuffer As String, _ ByVal nSize As Long) As Long Dim buffer As String, length As Integer buffer = Space$(512) length = GetSystemDirectory(buffer, Len(buffer)) Print "System Directory = " & Left$(buffer, length)

The GetTempPath API function uses a similar syntax—although the order of arguments is reversed—and returns a valid directory name for storing temporary files, including a trailing backslash character (such as C:\WINDOWS\TEMP\):

Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _ (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long Dim buffer As String, length As Integer buffer = Space$(512) length = GetTempPath (Len(buffer), buffer) Print "Temporary Directory = " & Left$(buffer, length)

The GetUserName function returns the name of the user currently logged in. At a first glance this function appears to use the same syntax as the functions I've just described. The documentation reveals, however, that it doesn't return the length of the result but just a zero value to indicate a failure or 1 to indicate the success of the operation. In this situation, you must extract the result from the buffer by searching for the Null character that all API functions append to result strings:

Private Declare Function GetUserName Lib "advapi32.dll" Alias _ "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long Dim buffer As String * 512, length As Long If GetUserName buffer, Len(buffer) Then ' Search the trailing Null character. length = InStr(buffer, vbNullChar) - 1 Print "User Name = " & Left$(buffer, length) Else Print "GetUserName function failed" End If

The GetComputerName API function, which retrieves the name of the computer that's executing the program, uses yet another method: You must pass the length of the buffer in a ByRef argument. On exit from the function, this argument holds the length of the result:

Private Declare Function GetComputerName Lib "kernel32" Alias _ "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long Dim buffer As String * 512, length As Long length = Len(buffer) If GetComputerName(buffer, length) Then ' Returns nonzero if successful, and modifies the length argument MsgBox "Computer Name = " & Left$(buffer, length) End If

Visual Basic's keyboard events let you know exactly which keys are pressed and when. At times, however, it's useful to determine whether a given key is pressed even when you're not inside a keyboard event procedure. The pure Visual Basic solution is to store the value of the pressed key in a module-level or a global variable, but it's a solution that negatively impacts the reusability of the code. Fortunately, you can easily retrieve the current state of a given key using the GetAsyncKeyState function:

Private Declare Function GetAsyncKeyState Lib "user32" _ (ByVal vKey As Long) As Integer

This function accepts a virtual key code and returns an Integer value whose high-order bit is set if the corresponding key is pressed. You can use all the Visual Basic vbKeyxxxx symbolic constants as arguments to this function. For example, you can determine whether any of the shift keys is being pressed using this code:

Dim msg As String If GetAsyncKeyState(vbKeyShift) And &H8000 Then msg = msg & "SHIFT " If GetAsyncKeyState(vbKeyControl) And &H8000 Then msg = msg & "CTRL " If GetAsyncKeyState(vbKeyMenu) And &H8000 Then msg = msg & "ALT " ' lblKeyboard is a Label control that displays the shift key states. lblKeyboard.Caption = msg

An interesting characteristic of the GetAsynchKeyState function is that it works even if the application doesn't have the input focus. This capability lets you build a Visual Basic program that reacts to hot keys even if users press them while they're working with another application. To use this API function to trap hot keys, you need to add some code into a Timer control's Timer event procedure and set the Timer's Interval property to a small enough value—for example, 200 milliseconds:

' Detect the Ctrl+Alt+A key combination. Private Sub Timer1_Timer() If GetAsyncKeyState(vbKeyA) And &H8000 Then If GetAsyncKeyState(vbKeyControl) And &H8000 Then If GetAsyncKeyState(vbKeyMenu) And &H8000 Then ' Process the Ctrl+Alt+A hot key here. End If End If End If End Sub

You can streamline your code by taking advantage of the following reusable routine, which can test the state of up to three keys:

Function KeysPressed(KeyCode1 As KeyCodeConstants, Optional KeyCode2 As _ KeyCodeConstants, Optional KeyCode3 As KeyCodeConstants) As Boolean If GetAsyncKeyState(KeyCode1) >= 0 Then Exit Function If KeyCode2 = 0 Then KeysPressed = True: Exit Function If GetAsyncKeyState(KeyCode2) >= 0 Then Exit Function If KeyCode3 = 0 Then KeysPressed = True: Exit Function If GetAsyncKeyState(KeyCode3) >= 0 Then Exit Function KeysPressed = True End Function

The three arguments are declared as KeyCodeConstant (an enumerated type defined in the Visual Basic runtime library), so that IntelliSense automatically helps you write the code for this function. See how you can rewrite the previous example that traps the Ctrl+Alt+A hot key:

If KeysPressed(vbKeyA, vbKeyMenu, vbKeyControl) Then ' Process the Ctrl+Alt+A hot key here. End If

You can also modify the current state of a key, say, to programmatically change the state of the CapsLock, NumLock, and ScrollLock keys. For an example of this technique, see the "Toggling the State of Lock Keys" section in Chapter 10.

The support Visual Basic offers to mouse programming is defective in a few areas. As is true for the keyboard and its event procedures, you can derive a few bits of information about the mouse's position and the state of its buttons only inside a MouseDown, MouseUp, or MouseMove event procedure, which makes the creation of reusable routines in BAS modules a difficult task. Even more annoying, mouse events are raised only for the control under the mouse cursor, which forces you to write a lot of code just to find out where the mouse is in any given moment. Fortunately, querying the mouse through an API function is really simple.

To begin with, you don't need a special function to retrieve the state of mouse buttons because you can use the GetAsyncKeyState function with the special vbKeyLButton, vbKeyRButton, and vbKeyMButton symbolic constants. Here's a routine that returns the current state of mouse buttons in the same bit-coded format as the Button parameter received by Mousexxxx event procedures:

Function MouseButton() As Integer If GetAsyncKeyState(vbKeyLButton) < 0 Then MouseButton = 1 End If If GetAsyncKeyState(vbKeyRButton) < 0 Then MouseButton = MouseButton Or 2 End If If GetAsyncKeyState(vbKeyMButton) < 0 Then MouseButton = MouseButton Or 4 End If End Function

The Windows API includes a function for reading the position of the mouse cursor:

Private Type POINTAPI X As Long Y As Long End Type Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) _ As Long

In both cases the coordinates are in pixels and relative to the screen:

' Display current mouse screen coordinates in pixels using a Label control. Dim lpPoint As POINTAPI GetCursorPos lpPoint lblMouseState = "X = " & lpPoint.X & " Y = " & lpPoint.Y

To convert screen coordinates to a pair of coordinates relative to the client area of a window—that is, the area of a window inside its border—you can use the ScreenToClient API function:

Private Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, _ lpPoint As POINTAPI) As Long ' Display mouse screen coordinates relative to current form. Dim lpPoint As POINTAPI GetCursorPos lpPoint ScreenToClient Me.hWnd, lpPoint lblMouseState = "X = " & lpPoint.X & " Y = " & lpPoint.Y

The SetCursorPos API function lets you move the mouse cursor anywhere on the screen, something that you can't do with standard Visual Basic code:

Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, _ ByVal Y As Long) As Long

When you use this function, you often need to convert from client coordinates to screen coordinates, which you do with the ClientToScreen API function. The following code snippet moves the mouse cursor to the center of a push button:

Private Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, _ lpPoint As POINTAPI) As Long ' Get the coordinates (in pixels) of the center of the Command1 button. ' The coordinates are relative to the button's client area. Dim lpPoint As POINTAPI lpPoint.X = ScaleX(Command1.Width / 2, vbTwips, vbPixels) lpPoint.Y = ScaleY(Command1.Height / 2, vbTwips, vbPixels) ' Convert to screen coordinates. ClientToScreen Command1.hWnd, lpPoint ' Move the mouse cursor to that point. SetCursorPos lpPoint.X, lpPoint.Y

In some circumstances, for example, during drag-and-drop operations, you might want to prevent the user from moving the mouse outside a given region. You can achieve this behavior by setting up a rectangular clipping area with the ClipCursor API function. You'll often need to clip the mouse cursor to a given window, which you can do by retrieving the window's client area rectangle with the GetClientRect API function and convert the result to screen coordinates. The following routine does everything for you:

Private Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long Sub ClipMouseToWindow(ByVal hWnd As Long) Dim lpPoint As POINTAPI, lpRect As RECT ' Retrieve the coordinates of the upper-left corner of the window. ClientToScreen hWnd, lpPoint ' Get the client screen rectangle. GetClientRect hWnd, lpRect ' Manually convert the rectangle to screen coordinates. lpRect.Left = lpRect.Left + lpPoint.X lpRect.Top = lpRect.Top + lpPoint.Y lpRect.Right = lpRect.Right + lpPoint.X lpRect.Bottom = lpRect.Bottom + lpPoint.Y ' Enforce the clipping. ClipCursor lpRect End Sub

Here's an example that uses the previous routine and then cancels the clipping effect:

' Clip the mouse cursor to the current form's client area. ClipMouseToWindow Me.hWnd ... ' When you don't need the clipping any longer. (Don't forget this!) ClipCursor ByVal 0&

(Remember that a window automatically loses the mouse capture if it executes a MsgBox or InputBox statement.) Windows normally sends mouse messages to the window under the cursor. The only exception to this rule occurs when the user presses a mouse button on a window and then drags the mouse cursor outside it. In this situation, the window continues to receive mouse messages until the button is released. But sometimes it's convenient to receive mouse notifications even when the mouse is outside the window's boundaries.

Consider the following situation: You want to provide the user with a visual clue when the mouse cursor enters the area of a control, for example by changing the control's background color. You can achieve this effect simply by changing the control's BackColor property in its MouseMove event because this event fires as soon as the mouse cursor hovers over the control. Unluckily, Visual Basic doesn't fire an event in a control when the mouse cursor exits its client area. Using pure Visual Basic, you're forced to write code inside the MouseMove events of the forms and of all the other controls on the form's surface, or you must have a Timer that periodically monitors where the mouse is. In no case is this an elegant or an efficient solution.

A better approach would be to capture the mouse when the cursor enters the control's client area, using the SetCapture API function. When a form or a control captures the mouse, it receives mouse messages until the user clicks outside the form or the control or until the mouse capture is explicitly relinquished through a ReleaseCapture API function. This technique permits you to solve the problem by writing code in one single procedure:

' Add these declarations to a BAS module. Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) _ As Long Private Declare Function ReleaseCapture Lib "user32" () As Long Private Declare Function GetCapture Lib "user32" () As Long ' Change the BackColor of Frame1 control to yellow when the mouse enters ' the control's client area, and restore it when the mouse leaves it. Private Sub Frame1_MouseMove(Button As Integer, Shift As Integer, _ X As Single, Y As Single) ' Set the mouse capture unless the control already has it. ' (The GetCapture API function returns the handle of the window that ' has the mouse capture.) If GetCapture <> Frame1.hWnd Then SetCapture Frame1.hWnd Frame1.BackColor = vbYellow ElseIf X < 0 Or Y < 0 Or X > Frame1.Width Or Y > Frame1.Height Then ' If the mouse cursor is outside the Frame's client area, release ' the mouse capture and restore the BackColor property. ReleaseCapture Frame1.BackColor = vbButtonFace End If End Sub

You can see this technique in action in the demonstration program shown in Figure A-4. Anytime the user moves the mouse onto or away from the topmost Frame control, its background color changes.

The WindowsFromPoint API function often comes handy when you're working with the mouse because it returns the handle of the window at given screen coordinates:

Private Declare Function WindowFromPointAPI Lib "user32" Alias _ "WindowFromPoint" (ByVal xPoint As Long, ByVal yPoint As Long) As Long

The following routine returns the handle of the window under the mouse cursor:

Function WindowFromMouse() As Long Dim lpPoint As POINTAPI GetCursorPos lpPoint WindowFromMouse = WindowFromPoint(lpPoint.X, lpPoint.Y) End Function

For example, you can quickly determine from within a form module which control is under the mouse cursor using the following approach:

Dim handle As Long, ctrl As Control On Error Resume Next handle = WindowFromMouse() For Each ctrl In Me.Controls If ctrl.hWnd <> handle Then ' Not on this control, or hWnd property isn't supported. Else ' For simplicity's sake, this routine doesn't account for elements ' of control arrays. Print "Mouse is over control " & ctrl.Name Exit For End If Next

For more information, see the source code of the demonstration application on the companion CD.